home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / tout.arc / TOUT.BAS next >
BASIC Source File  |  1985-06-22  |  5KB  |  136 lines
  1. 10   CLS
  2. 20   KEY OFF
  3. 30      REM THIS PROGRAM WAS ADAPTED FROM A PROGRAM BY ED SEEDHOUSE AND
  4. 40      REM MADE TO RUN ON IBM MS/DOS TYPE COMPUTERS.  THE ORIGINAL
  5. 50      REM PROGRAM WAS DOWNLOADED FROM GRANNY'S BBS IN COLWOOD.
  6. 60      REM THIS ADAPTATION WAS DONE BY CHRIS SPRATT, VICTORIA, BC.
  7. 70      REM WITH THE UNDERSTANDING THAT THE ORIGINAL WAS IN THE PUBLIC DOMAIN.
  8. 80      REM
  9. 90      REM
  10. 100   PRINT : PRINT
  11. 110   PRINT TAB(25) " A  HORSE RACING PROGRAM"
  12. 120   LOCATE 8,16:FOR L = 1 TO 50:PRINT CHR$(205);:NEXT
  13. 130   LOCATE 9,18:COLOR 15
  14. 140   PRINT "-------- PICK THE WINNERS AT THE TRACK --------"
  15. 150   LOCATE 10,16:COLOR 7
  16. 160   FOR L = 1 TO 50 :PRINT CHR$(205);:NEXT
  17. 170   PRINT : PRINT :
  18. 180   PRINT TAB(31) " BY CHRIS SPRATT"
  19. 190   PRINT
  20. 200   PRINT TAB(35) "JUNE 1985"
  21. 201   PRINT :PRINT
  22. 202   PRINT TAB(26) "WITH THANKS TO ED SEEDHOUSE"
  23. 210   PRINT
  24. 220   PRINT : PRINT : GOSUB 12000
  25. 230     REM
  26. 240     REM
  27. 250     REM
  28. 260     REM
  29. 1000  CLEAR 
  30. 1010 MM = 11
  31. 1020  DIM A$(MM),KW(MM),KP(MM),T(MM),R(MM),P(MM)
  32. 1030  DIM RW(MM),RP(MM),PW(MM),PP(MM),RO(MM),PO(MM)
  33. 1040  CLS 
  34. 1120  PRINT : PRINT : PRINT : PRINT : PRINT 
  35. 1130  FOR I = 1 TO 2000: NEXT I
  36. 1140  CLS
  37. 1150  PRINT "'TOUT ' IS DESIGNED TO HELP YOU PICK A WINNING HORSE AT THE TRACK! IF YOU'VE   EVER MULLED OVER A RACING FORM THEN THIS IS THE PROGRAM FOR YOU."
  38. 1160  PRINT : PRINT "  TO REALLY GRASP HOW WELL THIS PROGRAM RUNS, JUST USE AN OLD RACING FORM, AND  FILL IN THE INFORMATION AS REQUESTED.": PRINT
  39. 1170  PRINT "  THEN COMPARE THE WINNERS WITH 'TOUT I.THE RESULTS ARE NORMALLY POSTED IN THE  FOLLOWING DAYS FORM."
  40. 1180  PRINT:PRINT TAB(9)" YOU MIGHT BE IN FOR A BIG SURPRIZE.  GOOD LUCK!!!"
  41. 1185  PRINT :PRINT
  42. 1190  PRINT TAB(20)" HIT <ENTER> TO START ",:INPUT R$
  43. 1200  CLS :PRINT :PRINT :PRINT :PRINT
  44. 1210  PRINT TAB(25) "NAME OF TRACK  ",:INPUT C$
  45. 1220  PRINT TAB(25) "DATE (DD/MM)   ",:INPUT D$
  46. 1230  PRINT TAB(16) "WHICH RACE DO YOU WANT TO HANDICAP ? ",:INPUT  NR
  47. 1240 NH = 0
  48. 1250  CLS :PRINT :PRINT :PRINT :PRINT
  49. 1260  GOSUB 2060
  50. 1270  PRINT TAB(20)"NAME OF HORSE TO BE EVALUATED ",:INPUT A$(NH)
  51. 1280  PRINT TAB(20)"NUMBER OF RACES RUN THIS PERIOD ",:INPUT MR
  52. 1290  IF MR = 0 THEN  PRINT TAB(22)  "NO RACE HISTORY.   REJECT.": FOR I = 1 TO 1000: NEXT I: GOSUB 2060: GOTO 1270
  53. 1300  PRINT  TAB(20) "WINNINGS THIS PERIOD $" ,,:INPUT W
  54. 1310  PRINT  TAB(20) "FINISHES THIS PERIOD (1,2,3)  ",: INPUT  M1,M2,M3
  55. 1320 KW(NH) = W / MR
  56. 1330 KP(NH) = (3 * M1 + 2 * M2 + M3) / MR
  57. 1340  PRINT  TAB(20) "ANY MORE HORSES TO EXAMINE (Y/N)",:INPUT B$
  58. 1350  IF B$ = "N" THEN 1380
  59. 1360  IF B$ <  > "Y" THEN 1340
  60. 1370 NH = NH + 1: GOSUB 2060: GOTO 1270
  61. 1380  FOR J = 0 TO NH:T(J) = KW(J): NEXT J
  62. 1390  GOSUB 1930
  63. 1400  FOR J = 0 TO NH:RW(J) = R(J):PW(J) = P(J): NEXT J
  64. 1410  FOR J = 0 TO NH:T(J) = P(J): NEXT J
  65. 1420  GOSUB 1930
  66. 1430  FOR J = 0 TO NH:RP(J) = R(J):PP(J) = P(J): NEXT J
  67. 1440  FOR J = 0 TO NH:RO(J) = KW(J) * KP(J):T(J) = RO(J): NEXT J
  68. 1450  GOSUB 1930
  69. 1460  FOR J = 0 TO NH:PO(J) = P(J): NEXT J
  70. 1470  CLS:PRINT :PRINT :PRINT :PRINT
  71. 1480  PRINT TAB(18) "RACE # ";,NR;" AT ";,C$;" ON ";,D$
  72. 1490  PRINT TAB(18) "RANKING BASED ON $"W" WINNINGS"
  73. 1500  REM
  74. 1510  PRINT TAB(18) "RANK    NAME            $WIN/RACE"
  75. 1520  REM
  76. 1530  FOR J = 0 TO NH
  77. 1540  PRINT  TAB(18) J + 1; SPC(6)A$(PW(J));
  78. 1550  PRINT  TAB( 42)"$"; INT (KW(PW(J) + .005) * 100) / 100
  79. 1560  NEXT J
  80. 1570  PRINT : PRINT : PRINT : PRINT TAB(22) "HIT <ENTER>  WHEN REVIEW COMPLETE",: INPUT  B$
  81. 1580  REM
  82. 1590  CLS:PRINT :PRINT :PRINT :PRINT
  83. 1600  PRINT TAB(18) "RACE # ";,NR;" AT ";,C$;" ON ";,D$
  84. 1610  PRINT TAB(18) "RANKING BASED ON FINISH FACTOR"
  85. 1620  REM
  86. 1630  PRINT TAB(18) "RANK     NAME             FACTOR"
  87. 1640  REM
  88. 1650  FOR J = 0 TO NH
  89. 1660  PRINT TAB(18) J + 1; SPC( 6)A$(PP(J));
  90. 1670  PRINT  TAB( 45); INT (KP(PP(J) + .005) * 1000) / 1000
  91. 1680  NEXT J
  92. 1690  PRINT : PRINT : PRINT : PRINT  TAB(22) "HIT <ENTER>  WHEN REVIEW COMPLETE",:INPUT  BB$
  93. 1700  CLS :PRINT :PRINT :PRINT :PRINT
  94. 1710  PRINT TAB(18)"RACE # ";, NR;" AT ";, C$;" ON " ;,D$
  95. 1720  PRINT TAB(18)"RANKING BASED ON COMPOSITE SCORE"
  96. 1730  REM
  97. 1740  PRINT TAB(18)"RANK     NAME       COMPOSITE SCORE"
  98. 1750  REM
  99. 1760  FOR J = 0 TO NH
  100. 1770  PRINT TAB(18) J+ 1; SPC( 6)A$(PO(J));
  101. 1780  PRINT  TAB( 41); INT (RO(PO(J) + .005) * 1000) / 1000
  102. 1790  NEXT J
  103. 1800  PRINT : PRINT : PRINT : PRINT TAB(22) "HIT <ENTER> WHEN REVIEW COMPLETE",:INPUT Z$
  104. 1810  CLS :LOCATE 10,20
  105. 1820  PRINT "PERSONALLY, I LIKE "A$(PO(0))
  106. 1830  FOR J = 1 TO NH
  107. 1840  IF RO(PO(J)) < .9 * RO(PO(0)) THEN 1870
  108. 1850  PRINT TAB(30) "AND ";A$(PO(J))
  109. 1860  NEXT J
  110. 1870  REM
  111. 1880  PRINT :PRINT TAB(16)"ANOTHER RACE TO HANDICAP (Y/N)",
  112. 1890  INPUT R$
  113. 1900  IF R$ = "N" THEN 1920
  114. 1910  PRINT :PRINT :PRINT TAB(22) "WHICH RACE NEXT ",:INPUT NR: GOTO 1240
  115. 1920  END
  116. 1930  REM  ---SORTING SUBROUTINE---
  117. 1940  FOR J = 0 TO NH
  118. 1950 MX =  - 999
  119. 1960  FOR J1 = 0 TO NH
  120. 1970  IF T(J1) < MX THEN 2000
  121. 1980 MX = T(J1)
  122. 1990 JS = J1
  123. 2000  NEXT J1
  124. 2010 R(JS) = J
  125. 2020 P(J) = JS
  126. 2030 T(JS) =  - 9999
  127. 2040  NEXT J
  128. 2050  RETURN 
  129. 2060   PRINT  TAB( 39);" ":  RETURN 
  130. 11000 END
  131. 12000 LOCATE 24,26
  132. 13000 PRINT "PRESS ANY KEY TO CONTINUE"
  133. 14000 B$ = INPUT$ (1)
  134. 15000 CLS : PRINT : PRINT : PRINT : PRINT
  135. 16000 RETURN
  136.